#!/usr/local/bin/perl
use strict; use warnings;
use threads;
use threads::shared;
use feature qw/say/;
use File::Temp;
use File::Find;
use FindBin qw/$Bin/;
BEGIN{
    push @INC, $Bin;
}
use Cwd qw/getcwd abs_path/;
use Encode qw/find_encoding decode/;
binmode STDIN, ":utf8";
binmode STDOUT, ":utf8";
binmode STDERR, ":utf8";

use Gtk2;

my $num_option     = 3;
exit 1 if $#ARGV<=$num_option-1;
say "#PID:$$";
my $exreq=(($#ARGV==$num_option+1)&&($ARGV[$num_option] eq "..."))?1:0;
my $use_file_cmd   = substr($ARGV[0],0,1);
my $allow_dotfile  = substr($ARGV[0],1,1);
my $ignore_archive = substr($ARGV[0],2,1);
my $no_conversion  = substr($ARGV[0],3,1);
my $opt            = $ARGV[1];
my $pass           = $ARGV[2];
my $lddir="loaders";
if($exreq){
    say "#MSG:fck running in archive extraction mode";
    $ignore_archive=0;
}
my $have_lsof=system("which lsof > /dev/null")==0?1:0;
my $enc=Encode::find_encoding("UTF-8");
my $cwd=$enc->decode(getcwd);
local $|=1;
my $is_ok;
if($no_conversion&&$ignore_archive){
    $is_ok=sub{return undef;};
}else{
    if($use_file_cmd && system("which file > /dev/null")==0){
	require "imv_ftf.pm";
	&FTF::init_ftf(!$ignore_archive,!$no_conversion,$Bin."/$lddir");
	$is_ok=\&FTF::is_okf;
    }else{
	require "imv_fte.pm";
	&FTE::init_fte(!$ignore_archive,!$no_conversion,$Bin."/$lddir");
	$is_ok=\&FTE::is_oke;
    }
}
my $tmpdir;
my $nok :shared;
my $nin :shared;
my $war :shared;
my $spc :shared;
$spc=$nok=$nin=$war=0;
my $kf=$exreq?$num_option+1:$num_option;
my $pix=Gtk2::Gdk::Pixbuf->new("rgb",0,8,1,1);
{
    foreach(@ARGV[$kf..$#ARGV]){ # <<<<<<<<
	$_=$enc->decode($_);
	if(-d $_ && -r $_){
	    require "imv_dm.pm";
	    my $d=$_;
	    my $maxlc=100; # <<<
	    while(-l $d && $maxlc>0){
		my $s=$enc->decode(readlink($d));
		if(substr($s,0,1) eq "/"){ # source is abspath
		    $d=$s;
		}else{
		    $d=$enc->decode(abs_path($d)) if(substr($d,0,1) ne "/");
		    $d=~s/\/[^\/]*$//;
		    $d.="/".$s;
		}
		$maxlc--;
	    }
	    if($maxlc==0){
		say "#WARN:too much link count: $_";
		next;
	    }

	    my @n=&DM::get_flist(\&good_files,!$allow_dotfile,$d);
	    say "#".($n[0]?"MSG":"WARN")
		.":$n[0] file"
		.($n[0]>1?"s":"")
		." found in $d"
		.($n[1]?", $n[1] file".($n[1]>1?"s":"")." skipped.":".");
	}elsif(-r $_){
	    &good_files($_);
	}else{
	    say "#ERR:unreadable file or directory: $_";
	}
    }
}
say "#".($nok?"OK":"WARN").":$nin files examined, $nok accepted for read.";
say "#U1:",$war/$nok if $nok>=1;
exit 0;

sub watch_proc
{
    my $f=$_[0];
    sleep 1;
    return unless -e $f;
    return unless open my $fh, "lsof -F g \'$f\'|";
    my $s=do{local $/;<$fh>;};
    close $fh;
    my $g=getpgrp();
    while($s=~/p(\d+)\ng(\d+)/g){
	if($2==$g){
	    say "#PID:$1";
	    last;
	}
    }
    1;
}

sub watch_dir
{
    my ($dir,$plsr,$pfsz,$psta)=($_[0],$_[1],$_[2],$_[3]);
    my $kill;
    my $diff;
    my $dirp="...";
    my $udir;
    my $use_lsof=$have_lsof;
    $SIG{'KILL'}=sub{$use_lsof=0; system("sync"); sleep 1; $kill=1;}; #<<<<
    my $pisf=sub{
	return unless -r $_;
	return unless -f $_;
	my $dirc=getcwd;
	if($dirc ne $dirp){
	    $udir=$enc->decode($dirc)."/";
	    $dirp=$dirc;
	}
	my $f=$udir.$enc->decode($_);
	foreach(@$plsr){
	    return if $f eq $_;
	}
	$diff=1;
	push @$plsr, $f;
	push @$pfsz, -s $f;
    };
    while(1){
	$diff=0;
	find($pisf, $dir);
      FILE: for(my $k=0;$k<=$#$plsr;$k++){
	  next if defined $psta->[$k];
	  if($use_lsof){
	      next FILE unless -e $$plsr[$k];
	      my $a=`lsof -F a \'$$plsr[$k]\'`;
	      while($a=~/a([wu])/g){
		  next FILE;
	      }
	  }else{
	      my $s= -s $plsr->[$k];
	      next FILE unless $s;
	      if($pfsz->[$k]!=$s){
		  $diff=1;
		  $pfsz->[$k]=$s;
		  next FILE;
	      }
	  }
	  $psta->[$k]=&good_files($plsr->[$k]);
      }
	threads->exit() if($kill&&$diff==0);
	sleep 1;
    }
    1;
}

sub get_outdir
{
    unless(defined($tmpdir)){
	$ENV{"TMPDIR"}=$ENV{"IMVTMPDIR"} if exists $ENV{"IMVTMPDIR"};
	$tmpdir=File::Temp->newdir;
	$File::Temp::KEEP_ALL=1;
	say "#TMPDIR:$tmpdir";
    }
    my $f=$_[0];
    $f=~tr/\//./;
    my $d="$_[1]$f";
    if(length($enc->encode($d))>255){
	require "Digest/MD5.pm";
	say "#WARN:directory name too long: $d";
	$d=&Digest::MD5::md5_hex($enc->encode($d));
    }
    $d="$tmpdir/$d";
    return $d if((!-e $d && mkdir($d)) || (-d $d));
    say "#ERR:failed to set output directory for $_[0]: $!";
    return;
}

sub good_files{ # for gtk
    my $ngf=0;
    $spc++;
    foreach(@_){
	$nin++;
	my ($i,$w,$h)=$pix->get_file_info($_);
	#is_writable
	#name
	#license
	#mime_types
	#description
	#extensions
	#is_scalable
	#is_disabled
	if(!defined $i||$w<=1||$h<=1){ # some mpg returns image/vnd with $w=1
	    my $ft=&$is_ok($_);
	    unless(defined $ft){
	        say "#WARN:Reject: $_";
		next;
	    }elsif($ft=~/^\//){
		system("$ft $_");
		next;
	    }
	    require "imv_ft.pm";
	    my ($fp,$pf,$pm,$ms);
	    if(&FT::is_archive($ft)){
		$fp="EX";
		$pf=\&EX::extract;
		$pm="imv_ex.pm";
		$ms="extracted";
	    }else{
		$fp="CV";
		$pf=\&CV::convert;
		$pm="imv_cv.pm";
		$ms="converted";
	    }
	    my $f=$_;
	    $f=$cwd."/$_" if substr($_,0,1) ne "/";
	    my $d=get_outdir($f,$fp);
	    next unless defined $d;
	    require $pm;
	    my @fs :shared;
	    my @ss :shared;
	    my @os :shared;
	    my $tp=threads->create(\&watch_proc,$f) if $have_lsof;
	    my $td=threads->create(\&watch_dir,$d,\@fs,\@ss,\@os);
	    say "#ARXV:$spc:$f";
	    say "#OPATH:$spc:$d";
	    my $rc=$pf->($ft,$f,$d,$opt,$pass);
	    if($rc!=0){
		if($rc<256){
		    say "#ERR:system error: $rc";
		}else{
		    say "#ERR:returned status: ",$rc/256;
		}
	    }
	    $tp->join() if $have_lsof;
	    $td->kill('KILL')->join();
	    my $n=@fs;
	    say "#".($n?"MSG":"WARN").":$n file".($n>1?"s":"")." $ms from $_";
	    undef @fs;
	    undef @ss;
	    undef @os;
	}else{
	    $war+=$w/$h;
	    $_=$enc->decode(abs_path($_)) if substr($_,0,1) ne "/";
#	    $_=$cwd."/$_" if substr($_,0,1) ne "/";
	    say "#FILEI:$w,$h,$_";
#	    say "#FILE:$_";
	    $nok++;
	    $ngf++;
	}
    }
    $spc--;
    return $ngf;
}
